donwload the data [https://data.mendeley.com/datasets/ntgfb38k69/3]

1- Flow Curve

Variables in the DataFrame:

Shear rate (how fast the material deforms). Shear stress (measured force per unit area). Viscosity (τ/γ̇, ratio of shear stress to shear rate). Torque (motor force generating the deformation).

rutas_archivos <- list.files(path = ".", pattern = "flow_data.csv", recursive = TRUE, full.names = TRUE)

lista_datos <- lapply(rutas_archivos, function(ruta){
  read.csv(ruta, skip = 1)
})

names(lista_datos) <- basename(dirname(rutas_archivos))

This code is gonna split the viscosity data like this:

Low shear viscosity: between 0.1–1 s⁻¹ Medium shear viscosity: between 10–100 s⁻¹ High shear viscosity: between 500–1000 s⁻¹

The idea is that when you put cream on your skin with your hand, the shear rates are usually in these ranges:

Slow moves: like 0.1–1 s⁻¹ (when you move the cream super slow on your skin). Normal moves: like 10–100 s⁻¹ (when you rub it normally). Fast/strong moves: more than 100 s⁻¹ (when you rub really fast or hard).

names(lista_datos) <- basename(dirname(rutas_archivos))
library(dplyr)

for (i in 1:length(lista_datos)) {
  lista_datos[[i]] <- lista_datos[[i]] %>%
    mutate(
      conc = names(lista_datos[i]),  # Añade el nombre del elemento i como columna 'conc'
      range_viscosity = case_when(
        shear.rate..1.s. <= 10 ~ "Low_shear",
        shear.rate..1.s. > 10 & shear.rate..1.s. <= 100 ~ "Medium_shear",
        shear.rate..1.s. > 100 ~ "High_shear"
      ) 
    )  
}

flow_data <- do.call(rbind, lista_datos) %>% 
    dplyr::rename(shear.rate = shear.rate..1.s., shear.stress = shear.stress..Pa., 
           viscosity = viscosity..Pa.s., Torque = Torque..μN.m.)
#flow_data

In these parts of the code, we calculate the slope of log(viscosity) vs. log(shear rate). This shows how much the viscosity goes down when the shear rate increases. it is call thinning index. If n < 1, it means the material gets thinner when you move it faster.

library(plotly)
flow_data_p <- flow_data %>% 
  group_by(conc) %>% 
  ggplot(aes(x = log(shear.rate), y = log(viscosity), colour = conc)) +
  geom_line() +
  labs(
    title = "Curva de Flujo",
    x = "Log(Tasa de Cizalla)",
    y = "Log(Viscosidad)"
  ) + 
  theme_classic()

ggplotly(flow_data_p)
library(dplyr)
library(tidyr)
library(broom)
# ajustes de los modelos lineales
flow_data %>%
  group_by(conc) %>%
  dplyr::do(glance(lm(log(viscosity) ~ log(shear.rate), data = .)))
# A tibble: 13 × 13
# Groups:   conc [13]
   conc         r.squared adj.r.squared  sigma statistic   p.value    df  logLik
   <chr>            <dbl>         <dbl>  <dbl>     <dbl>     <dbl> <dbl>   <dbl>
 1 NaCl_0.1_XG      0.983         0.983 0.209     20330. 1.85e-315     1  53.8  
 2 NaCl_0.3_XG      0.984         0.984 0.193     22209. 3.71e-322     1  81.7  
 3 NaCl_0.4_XG      0.998         0.998 0.0775   187361. 0             1 408.   
 4 NaCl_0.5_XG      0.997         0.997 0.0850   131044. 0             1 375.   
 5 NaCl_0.7_XG      0.986         0.986 0.198     24714. 0             1  72.2  
 6 NaCl_0_XG        0.987         0.987 0.197     26186. 0             1  74.6  
 7 NaCl_0_XG_2…     0.975         0.974 0.280      5764. 1.37e-121     1 -21.0  
 8 XG_NaCl_0.05     0.981         0.981 0.236     17937. 5.58e-306     1   9.50 
 9 XG_NaCl_0.1      0.977         0.977 0.252     14865. 8.28e-292     1 -13.0  
10 XG_NaCl_0.3      0.974         0.974 0.225     13370. 7.78e-284     1  27.2  
11 XG_NaCl_0.5      0.979         0.979 0.239     16377. 4.12e-299     1   4.85 
12 XG_NaCl_0.7      0.978         0.978 0.243     15530. 4.17e-295     1  -0.901
13 XG_NaCl_0.9      0.971         0.971 0.255     11922. 3.04e-275     1 -17.4  
# ℹ 5 more variables: AIC <dbl>, BIC <dbl>, deviance <dbl>, df.residual <int>,
#   nobs <int>

Shear-thinning: the viscosity goes down when the speed is increased

# pendientes Shear-thinning index (n) (n−1).Eso te da el índice de adelgazamiento.
library(janitor)
Shear_thinning <- flow_data %>%
  group_by(conc) %>%
  dplyr::do(broom::tidy(lm(log(viscosity) ~ log(shear.rate), data = .))) %>% 
  select(conc,term, estimate, estimate) %>% 
  tidyr::pivot_wider(names_from = 'term', values_from = 'estimate', names_prefix = '') %>% 
  rename_with(~ make.names(.), .cols = everything()) %>%  # removing parentheses
  dplyr::rename(intercept = X.Intercept., Shear_thinning = log.shear.rate.) %>% 
  select(-intercept)

Shear_thinning
# A tibble: 13 × 2
# Groups:   conc [13]
   conc           Shear_thinning
   <chr>                   <dbl>
 1 NaCl_0.1_XG            -0.473
 2 NaCl_0.3_XG            -0.457
 3 NaCl_0.4_XG            -0.533
 4 NaCl_0.5_XG            -0.489
 5 NaCl_0.7_XG            -0.495
 6 NaCl_0_XG              -0.507
 7 NaCl_0_XG_2019         -0.480
 8 XG_NaCl_0.05           -0.503
 9 XG_NaCl_0.1            -0.488
10 XG_NaCl_0.3            -0.413
11 XG_NaCl_0.5            -0.487
12 XG_NaCl_0.7            -0.482
13 XG_NaCl_0.9            -0.442

If the slope (n) is around 0.5, the material is shear-thinning. That means its viscosity drops fast when you increase the shear rate. It feels thick at first, but as soon as you rub it, it gets really thin. This matches what we see with the viscosity: high viscosity at low shear rates, but low viscosity at high shear rates.

The next code calculates the average viscosity for each shear rate group: low, medium, and high.

viscosity_range <- flow_data %>% 
  group_by(conc, range_viscosity) %>% 
  summarise(avg_viscosity = mean(viscosity), .groups = 'drop') %>% 
  pivot_wider(names_from = 'range_viscosity', values_from = 'avg_viscosity', names_prefix = 'avgVisc_') %>% 
  select(conc, avgVisc_Low_shear, avgVisc_Medium_shear, everything())


viscosity_range %>%
  pivot_longer(
    cols = starts_with("avgVisc_"),
    names_to = "shear_type",
    values_to = "avg_viscosity"
  ) %>%
  mutate(
    shear_type = factor(shear_type, levels = c("avgVisc_Low_shear", "avgVisc_Medium_shear", "avgVisc_High_shear"))
  ) %>%
  ggplot(aes(x = conc, y = avg_viscosity, fill = shear_type)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Viscosidad Promedio por Tipo de Cizalla",
    x = "Muestra",
    y = "Viscosidad Promedio",
    fill = "Tipo de Cizalla"
  ) +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 7)) 

viscosity_range 
# A tibble: 13 × 4
   conc           avgVisc_Low_shear avgVisc_Medium_shear avgVisc_High_shear
   <chr>                      <dbl>                <dbl>              <dbl>
 1 NaCl_0.1_XG                0.296               0.0249            0.00757
 2 NaCl_0.3_XG                0.232               0.0223            0.00665
 3 NaCl_0.4_XG                0.433               0.0225            0.00672
 4 NaCl_0.5_XG                0.300               0.0215            0.00688
 5 NaCl_0.7_XG                0.315               0.0235            0.00674
 6 NaCl_0_XG                  0.455               0.0317            0.00897
 7 NaCl_0_XG_2019             0.528               0.0322            0.00936
 8 XG_NaCl_0.05               0.415               0.0303            0.00826
 9 XG_NaCl_0.1                0.324               0.0260            0.00721
10 XG_NaCl_0.3                0.153               0.0194            0.00605
11 XG_NaCl_0.5                0.304               0.0242            0.00686
12 XG_NaCl_0.7                0.283               0.0232            0.00663
13 XG_NaCl_0.9                0.213               0.0226            0.00670

Low shear: High viscosity—could be a thick or heavy cream. Medium shear: Viscosity drops a lot between low and medium shear, so the cream probably feels lighter when you rub it. High shear: Viscosity is very low here—the cream gets thin and spreads easily.

The code then combines the average viscosity data and the thinning index.

flow_curve <- inner_join(x = viscosity_range, y = Shear_thinning, by = "conc")
flow_curve
# A tibble: 13 × 5
   conc           avgVisc_Low_shear avgVisc_Medium_shear avgVisc_High_shear
   <chr>                      <dbl>                <dbl>              <dbl>
 1 NaCl_0.1_XG                0.296               0.0249            0.00757
 2 NaCl_0.3_XG                0.232               0.0223            0.00665
 3 NaCl_0.4_XG                0.433               0.0225            0.00672
 4 NaCl_0.5_XG                0.300               0.0215            0.00688
 5 NaCl_0.7_XG                0.315               0.0235            0.00674
 6 NaCl_0_XG                  0.455               0.0317            0.00897
 7 NaCl_0_XG_2019             0.528               0.0322            0.00936
 8 XG_NaCl_0.05               0.415               0.0303            0.00826
 9 XG_NaCl_0.1                0.324               0.0260            0.00721
10 XG_NaCl_0.3                0.153               0.0194            0.00605
11 XG_NaCl_0.5                0.304               0.0242            0.00686
12 XG_NaCl_0.7                0.283               0.0232            0.00663
13 XG_NaCl_0.9                0.213               0.0226            0.00670
# ℹ 1 more variable: Shear_thinning <dbl>

Low shear = first impression. Medium shear = normal experience. High shear = extreme behavior. Slope = how much it changes between these situations.

2. ampl_sweeps.csv

Variables in the DataFrame:

strain [%]: how much it’s stretched/deformed. shear stress [Pa]: the force measured. storage modulus [Pa] (G′): elastic part (stores energy, solid-like). loss modulus [Pa] (G″): viscous part (loses energy, liquid-like).

amplitude sweep data.

library(dplyr)
library(ggplot2)
library(tidyr)
rutas_archivos_ampl_sweeps <- list.files(path = ".", pattern = "ampl_sweeps.csv", recursive = TRUE, full.names = TRUE)
lista_datos_ampl_sweeps <- lapply(rutas_archivos_ampl_sweeps, function(ruta){
  read.csv(ruta, skip = 1, sep = c(',',";"))
})
names(lista_datos_ampl_sweeps) <- basename(dirname(rutas_archivos_ampl_sweeps))

for(i in 1:length(lista_datos_ampl_sweeps)){
  lista_datos_ampl_sweeps[[i]] <- lista_datos_ampl_sweeps[[i]] %>% 
    mutate(
      conc = as.factor(names(lista_datos_ampl_sweeps[i]))
    )
}

ampl_sweeps_df <- do.call(rbind, lista_datos_ampl_sweeps) %>% 
  dplyr::rename(strain= strain...., shear.stress = shear.stress..Pa., 
                storage.modulus = storage.modulus..Pa., loss.modulus = loss.modulus..Pa.) 

#ampl_sweeps_df

This is a general graph of the amplitude sweeps for all 13 samples, showing the loss modulus (G″) and storage modulus (G′).

library(plotly)
ampl_sweeps_g <- ampl_sweeps_df %>%
  group_by(conc) %>% 
  #dplyr::filter(conc == "NaCl_0.5_XG") %>%
  slice(c(8:n())) %>% 
  tidyr::pivot_longer(
    cols = c(storage.modulus, loss.modulus),
    names_to = "modulus_type",
    values_to = "modulus_value"
  ) %>% 
    ggplot(aes(x=strain, y = modulus_value, colour = modulus_type)) +
  geom_line(
    aes(color= conc, linetype = modulus_type)
  ) +
  theme_classic() 
ggplotly(ampl_sweeps_g)

This shows the linear viscoelastic regions (LVR) of the samples. There’s no clear LVR region in the data.

library(ggmagnify)
library(ggplot2)
from <- c(xmin = 5, xmax = 45, ymin = 0.15, ymax = 0.25)
to <- c(500, 1500 , 0.15, 0.35)
ampl_sweeps_df %>% 
  filter(conc == 'NaCl_0.1_XG') %>% 
  pivot_longer(cols = c(storage.modulus, loss.modulus),
               names_to = 'modulus_type',
               values_to = 'modulus_value') %>% 
  ggplot(aes(x=strain, y = modulus_value, colour = modulus_type,  label = modulus_type)) +
  geom_line() +
  theme_classic() +
   ggmagnify::geom_magnify(from = from, 
                           to = to,axes = "xy",
                           proj = "facing",colour = "black", 
                           linetype = 1, proj.fill = alpha("yellow", 0.1))

G′ and G″ in the linear zone show the initial texture: firmness vs. flow. Using the average G′ and G″ in the LVR zone (even though there’s no clear LVR).

Even if there’s no obvious LVR, zooming into the first data points shows a short linear region.

# VELR PLOTS
ampl_sweeps_df %>% 
  group_by(conc) %>% 
  mutate(
    diff_loss =abs(loss.modulus-lag(loss.modulus)) # se resta el valor loss.modulus con su anterior para obtener residuo
  ) %>% 
  dplyr::filter(
    diff_loss <= 0.015, # se filtran residuos menores a 0.015, para obtener los puntos mas cercanos
    loss.modulus >= mean(.$loss.modulus[.$diff_loss < 0.015], na.rm = T) # se siltran los valores de loss.modulus mayor a su media
    ) %>% 
  select(-diff_loss) %>%  
  pivot_longer(
    cols = c(storage.modulus, loss.modulus),
    names_to = "modulus_type",
    values_to = "modulus_value"
  ) %>% 
  ggplot(aes(x=strain, y = modulus_value, colour = modulus_type)) +
  geom_line(
    aes(color= conc, linetype = modulus_type)
  ) +
  theme_classic() 

G′/G″ (tan δ) More elastic or more liquid at the start. tan δ < 1 → elastic material (firm gel). tan δ > 1 → viscous material (fluid).

mean_modulsdf <- ampl_sweeps_df %>% 
  group_by(conc) %>% 
  mutate(
    diff_loss =abs(loss.modulus-lag(loss.modulus)) # se resta el valor loss.modulus con su anterior para obtener residuo
  ) %>% 
  dplyr::filter(
    diff_loss <= 0.015, # se filtran residuos menores a 0.015, para obtener los puntos mas cercanos
    loss.modulus >= mean(loss.modulus[diff_loss < 0.015], na.rm = T)# se siltran los valores de loss.modulus mayor a su media
    ) %>% 
  select(-diff_loss) %>%  
  pivot_longer(
    cols = c(storage.modulus, loss.modulus),
    names_to = "modulus_type",
    values_to = "modulus_value"
  ) %>% 
  group_by(modulus_type,conc) %>% 
  summarise(mean_modul = mean(modulus_value),.groups= 'drop') %>% 
  pivot_wider(names_from = modulus_type, values_from = mean_modul) %>% 
  mutate(tangent_delta = loss.modulus/storage.modulus) %>% 
  rename(avg_loss.modulus = loss.modulus, avg_storage.modulus = storage.modulus)
mean_modulsdf
# A tibble: 13 × 4
   conc           avg_loss.modulus avg_storage.modulus tangent_delta
   <fct>                     <dbl>               <dbl>         <dbl>
 1 NaCl_0.1_XG               0.209               0.193         1.08 
 2 NaCl_0.3_XG               0.184               0.167         1.10 
 3 NaCl_0.4_XG               0.198               0.174         1.14 
 4 NaCl_0.5_XG               0.190               0.180         1.05 
 5 NaCl_0.7_XG               0.204               0.191         1.07 
 6 NaCl_0_XG                 0.336               0.377         0.891
 7 NaCl_0_XG_2019            0.424               0.367         1.15 
 8 XG_NaCl_0.05              0.278               0.303         0.918
 9 XG_NaCl_0.1               0.230               0.254         0.906
10 XG_NaCl_0.3               0.199               0.159         1.25 
11 XG_NaCl_0.5               0.226               0.221         1.02 
12 XG_NaCl_0.7               0.213               0.202         1.05 
13 XG_NaCl_0.9               0.229               0.211         1.09 

Yield strain (γ_yield) The point where G′ drops 10–20% from its LVR value shows how much deformation it can handle before breaking. This gives the yield shear stress (τ_yield)—the force needed to break the internal structure.

γ_yield and τ_yield are calculated based on the 20% drop in G′ after the LVR.

# Vector con los valores de Gprime_threshold
Gprime_threshold <- mean_modulsdf$avg_storage.modulus * 0.8 # para calcular el 20 % de decaimineto del loss module

thresholds <- setNames(object = Gprime_threshold, nm = levels(ampl_sweeps_df$conc))

y_strain_stress <- ampl_sweeps_df %>% 
  group_by(conc) %>% 
  dplyr::filter(storage.modulus >= thresholds[as.character(first(conc))]) %>% 
  slice_tail(n = 1) %>% 
  ungroup() %>% 
  rename(yield_strain = strain, yield_stress = shear.stress) %>% 
  select(-storage.modulus,-loss.modulus)

y_strain_stress
# A tibble: 13 × 3
   yield_strain yield_stress conc          
          <dbl>        <dbl> <fct>         
 1         65.8        0.171 NaCl_0.1_XG   
 2         93.5        0.21  NaCl_0.3_XG   
 3         86.3        0.207 NaCl_0.4_XG   
 4         72.6        0.171 NaCl_0.5_XG   
 5         84.1        0.209 NaCl_0.7_XG   
 6         82.4        0.379 NaCl_0_XG     
 7         86.1        0.377 NaCl_0_XG_2019
 8         85.2        0.309 XG_NaCl_0.05  
 9         81.4        0.256 XG_NaCl_0.1   
10        111.         0.254 XG_NaCl_0.3   
11         89.9        0.254 XG_NaCl_0.5   
12         77.8        0.207 XG_NaCl_0.7   
13        112.         0.310 XG_NaCl_0.9   

Dinal Dataframe

ampl_sweep <- inner_join(x = mean_modulsdf, y = y_strain_stress, by = 'conc')
ampl_sweep
# A tibble: 13 × 6
   conc          avg_loss.modulus avg_storage.modulus tangent_delta yield_strain
   <fct>                    <dbl>               <dbl>         <dbl>        <dbl>
 1 NaCl_0.1_XG              0.209               0.193         1.08          65.8
 2 NaCl_0.3_XG              0.184               0.167         1.10          93.5
 3 NaCl_0.4_XG              0.198               0.174         1.14          86.3
 4 NaCl_0.5_XG              0.190               0.180         1.05          72.6
 5 NaCl_0.7_XG              0.204               0.191         1.07          84.1
 6 NaCl_0_XG                0.336               0.377         0.891         82.4
 7 NaCl_0_XG_20…            0.424               0.367         1.15          86.1
 8 XG_NaCl_0.05             0.278               0.303         0.918         85.2
 9 XG_NaCl_0.1              0.230               0.254         0.906         81.4
10 XG_NaCl_0.3              0.199               0.159         1.25         111. 
11 XG_NaCl_0.5              0.226               0.221         1.02          89.9
12 XG_NaCl_0.7              0.213               0.202         1.05          77.8
13 XG_NaCl_0.9              0.229               0.211         1.09         112. 
# ℹ 1 more variable: yield_stress <dbl>